home *** CD-ROM | disk | FTP | other *** search
/ Speccy ClassiX 1998 / Speccy ClassiX 98.iso / amiga_system / the_aminet / dev / m2 / showerror.lha / ShowError.mod < prev   
Text File  |  1995-10-03  |  18KB  |  601 lines
  1. (*(*-------------------------------------------------------------------------
  2.   :Program.    ModGen
  3.   :Contents.   Displays Turbo Modula-2 errors in ARexx based Editors
  4.   :Author.     Frank L÷mker
  5.   :Address.    E-Mail: floemker@techfak.uni-bielefeld.de
  6.   :Copyright.  FreeWare
  7.   :Language.   Modula-2
  8.   :Translator. Turbo Modula-2 V1.40
  9.   :History.    1.0 [Frank] 03-Oct-95
  10.   :Bugs.       no known
  11. -------------------------------------------------------------------------*)*)
  12.  
  13. MODULE ShowError;
  14.  
  15. IMPORT e:=Exec, d:=Dos{37}, i:=Intuition, r:=Rexx, a:=AmigaLib,
  16.        s:=String (* , io:=StdIO *);
  17. FROM M2Lib IMPORT _ErrorReq,malloc,free;
  18. FROM SYSTEM IMPORT STRING,ADR,ADDRESS,LONGSET;
  19.  
  20. CONST Version="$VER: ShowError V1.0 (3.10.95) by Frank L÷mker\n";
  21.       ErrFile="t:Errors";
  22.       ConfigFile="Modula:s/ShowError.config";
  23.       PortName="SHOWERROR";
  24.       ReplyName="ShowEReply";
  25.       tempDos="PORT/K,QUIT/S,READ/S,FIRST/S,NEXT/S,PREV/S";
  26.       tempRexx="PORT/K,QUIT/S,READ/S,FIRST/S,NEXT/S,PREV/S,LINE/S,COLUMN/S";
  27.       errMem="Error: Not enough memory";
  28. TYPE str60=ARRAY [0..60] OF CHAR;
  29.      str255=ARRAY [0..255] OF CHAR;
  30.      Pchars=POINTER TO ARRAY [1..MAX(LONGINT)] OF CHAR;
  31.      ListPtr=POINTER TO List;
  32.      List=RECORD
  33.             next:ListPtr;
  34.             zeile,spalte,size:INTEGER;
  35.           END;
  36.      Tconfig=RECORD
  37.                buf:Pchars;
  38.                len:LONGINT;
  39.                port,text,line,col,notify:STRING;
  40.                newport,multiline:BOOLEAN;
  41.                width:INTEGER;
  42.              END;
  43. VAR rootL,aktErr:ListPtr;
  44.     ioPort:e.MsgPortPtr;
  45.     config:Tconfig;
  46.     buffer:str60;
  47.     replyCnt:INTEGER;
  48.  
  49. PROCEDURE Request (str,dat:STRING);
  50. VAR easy:i.EasyStruct;
  51. BEGIN
  52.   easy:=[SIZE(i.EasyStruct),{},"ShowError",str,"OK"];
  53.   i.EasyRequestArgs (NIL,ADR(easy),NIL,ADR(dat));
  54. END Request;
  55.  
  56. PROCEDURE senden (reply:e.MsgPortPtr;repname,port,arg:STRING):BOOLEAN;
  57. VAR RexxMsg:r.RexxMsgPtr;
  58.     DestPort:e.MsgPortPtr;
  59. BEGIN
  60.   RexxMsg:=r.CreateRexxMsg (reply,NIL,repname);
  61.   IF RexxMsg=NIL THEN
  62.     Request ("Unable to create RexxMsg",NIL); RETURN FALSE;
  63.   END;
  64.   WITH RexxMsg^ DO
  65.     rm_Args[0]:=r.CreateArgstring (arg,s.strlen(arg));
  66.     IF rm_Args[0]=NIL THEN
  67.       r.DeleteRexxMsg (RexxMsg);
  68.       Request ("Unable to create RexxMsg",NIL);
  69.       RETURN FALSE;
  70.     END;
  71.     rm_Action:=r.RXCOMM;
  72.     rm_Node.mn_Node.ln_Name:="REXX";
  73.   END;
  74.   e.Forbid;
  75.   DestPort:=e.FindPort (port);
  76.   IF DestPort#NIL THEN
  77.     e.PutMsg (DestPort,RexxMsg);
  78.     e.Permit;
  79.     INC (replyCnt);
  80.   ELSE
  81.     e.Permit;
  82.     r.DeleteArgstring (RexxMsg^.rm_Args[0]);
  83.     RexxMsg^.rm_Node.mn_Node.ln_Name:=NIL;
  84.     r.DeleteRexxMsg (RexxMsg);
  85.     Request ('Unable to find MessagePort "%s"',port);
  86.     RETURN FALSE;
  87.   END;
  88.   RETURN TRUE;
  89. END senden;
  90.  
  91. PROCEDURE sendText (msg,arg:STRING):BOOLEAN;
  92. VAR copyProc:LONGCARD;
  93.     liste:ListPtr;
  94.     help:STRING;
  95.     data:ARRAY [0..2] OF ADDRESS;
  96.     length,nr,anz,pos:INTEGER;
  97.     ok:BOOLEAN;
  98. BEGIN
  99.   copyProc:=16C04E75H; ok:=FALSE;
  100.   WITH config DO
  101.    IF text#NIL THEN
  102.     length:=s.strlen(msg);
  103.     help:=malloc (length+(length-1) DIV width+1);
  104.     IF help=NIL THEN
  105.       Request (errMem,NIL);
  106.     ELSE
  107.       s.strcpy (help,msg);
  108.       IF length>width THEN
  109.         IF multiline THEN
  110.           anz:=(length-1) DIV width;
  111.           FOR nr:=anz TO 1 BY -1 DO
  112.             s.memmove (ADDRESS(help)+nr*width+1,ADDRESS(help)+nr*width,
  113.                        length-nr*width+1);
  114.             help^[nr*width]:="\n";
  115.             INC (length);
  116.           END;
  117.         ELSE
  118.           help^[width]:=0C;
  119.         END;
  120.       END;
  121.       liste:=rootL; anz:=0; pos:=0;
  122.       WHILE liste#NIL DO
  123.         INC (anz);
  124.         IF liste=aktErr THEN pos:=anz; END;
  125.         liste:=liste^.next;
  126.       END;
  127.       nr:=0; length:=0; ok:=FALSE;
  128.       WHILE (text^[nr]#0C) AND (length<3) DO
  129.         IF text^[nr]="%" THEN
  130.           REPEAT
  131.             INC (nr);
  132.           UNTIL (text^[nr]="%") OR (text^[nr]=0C) OR
  133.                 (text^[nr]="s") OR (text^[nr]="d");
  134.           IF text^[nr]="s" THEN
  135.             data[length]:=help;
  136.             INC (length);
  137.           ELSIF text^[nr]="d" THEN
  138.             IF ok THEN data[length]:=anz
  139.                   ELSE data[length]:=pos; END;
  140.             INC (length); ok:=TRUE;
  141.           ELSIF (text^[nr]="%") AND (text^[nr-1]="%") THEN INC (nr); END;
  142.         ELSE INC (nr); END;
  143.       END;
  144.       e.RawDoFmt (text,ADR(data),PROC(ADR(copyProc)),arg);
  145.       ok:=senden (ioPort,PortName,port,arg);
  146.       free (help);
  147.     END;
  148.    END;
  149.   END;
  150.   RETURN ok;
  151. END sendText;
  152.  
  153. PROCEDURE Fehler (msg:STRING);
  154. VAR arg:STRING;
  155. BEGIN
  156.   IF config.port#NIL THEN
  157.     arg:=malloc (s.strlen(config.text)+s.strlen(msg)+25);
  158.     IF arg=NIL THEN
  159.       Request (errMem,NIL);
  160.     ELSE
  161.       IF NOT sendText (msg,arg) THEN
  162.         Request (msg,NIL);
  163.       END;
  164.       free (arg);
  165.     END;
  166.   END;
  167. END Fehler;
  168.  
  169. PROCEDURE FileSize (dat:d.FileHandlePtr):LONGINT;
  170. BEGIN
  171.   d.Seek (dat,0,d.OFFSET_END);
  172.   RETURN d.Seek (dat,0,d.OFFSET_BEGINNING);
  173. END FileSize;
  174.  
  175. PROCEDURE LoadDat (name:STRING;VAR buf:Pchars;VAR len:LONGINT):BOOLEAN;
  176. VAR dat:d.FileHandlePtr;
  177.     anz:LONGINT;
  178.     ok:BOOLEAN;
  179. BEGIN
  180.   ok:=FALSE;
  181.   dat:=d.Open (name,d.MODE_OLDFILE);
  182.   IF dat#NIL THEN
  183.     len:=FileSize (dat);
  184.     IF len>0 THEN
  185.       INC (len);    (* 0C *)
  186.       buf:=e.AllocMem (len,{});
  187.       IF buf#NIL THEN
  188.         anz:=d.Read (dat,buf,len-1);
  189.         IF anz=len-1 THEN
  190.           buf^[len]:=0C; ok:=TRUE;
  191.         END;
  192.       END;
  193.     END;
  194.     d.Close (dat);
  195.   END;
  196.   RETURN ok;
  197. END LoadDat;
  198.  
  199. PROCEDURE LoadConfig (VAR config:Tconfig);
  200. VAR SText:ARRAY [0..6] OF STRING;
  201.     help:STRING;
  202.     nr,stelle,length:INTEGER;
  203.     start,found:BOOLEAN;
  204. BEGIN
  205.   SText:=["PORT","TEXT","LINE","COLUMN","NOTIFY","MULTILINE","WIDTH"];
  206.   WITH config DO
  207.     IF LoadDat (ConfigFile,buf,len) AND (len>12) THEN
  208.       FOR nr:=0 TO 6 DO
  209.         length:=s.strlen (SText[nr]);
  210.         help:=ADDRESS(buf); start:=TRUE; found:=FALSE;
  211.         REPEAT
  212.           IF (help^[0]="\n") OR (help^[0]=0C) OR start THEN
  213.             IF NOT start THEN help:=ADDRESS(ADDRESS(help)+1); END;
  214.             start:=FALSE;
  215.             stelle:=0;
  216.             WHILE (stelle<length) AND (CAP(help^[stelle])=SText[nr]^[stelle]) DO
  217.               INC (stelle);
  218.             END;
  219.             IF stelle=length THEN
  220.               WHILE help^[stelle]=" " DO INC(stelle); END;
  221.               IF help^[stelle]="=" THEN
  222.                 found:=TRUE;
  223.                 REPEAT INC (stelle); UNTIL help^[stelle]#" ";
  224.               END;
  225.             END;
  226.           ELSE
  227.             help:=ADDRESS(ADDRESS(help)+1);
  228.           END;  (* IF (help^[0] *)
  229.         UNTIL (ADDRESS(help)>ADDRESS(buf)+len-length) OR found;
  230.         help:=ADDRESS(ADDRESS(help)+stelle);
  231.         IF found AND (help^[0]#"\n") AND (help^[0]#0C) THEN
  232.           CASE nr OF
  233.             0: IF NOT newport THEN port:=help; END;
  234.            |1: text:=help;
  235.            |2: line:=help;
  236.            |3: col:=help;
  237.            |4: notify:=help;
  238.            |5: IF (CAP(help^[0])="N") AND (CAP(help^[1])="O") THEN
  239.                  multiline:=FALSE;
  240.                ELSE multiline:=TRUE; END;
  241.            |6: stelle:=0; width:=0;
  242.                WHILE (help^[stelle]>="0") AND (help^[stelle]<="9") AND (width<1000) DO
  243.                  width:=width*10+ORD(help^[stelle])-ORD("0");
  244.                  INC (stelle);
  245.                END;
  246.                IF width<10 THEN width:=10
  247.                ELSIF width>1000 THEN width:=1000; END;
  248.           END;
  249.           stelle:=0; length:=0;
  250.           WHILE (help^[stelle]#"\n") AND (help^[stelle]#0C) DO
  251.             IF (CAP(help^[stelle])="N") AND (help^[stelle-1]="\\") THEN
  252.               INC (length);
  253.               help^[stelle-length]:="\n";
  254.             ELSE
  255.               help^[stelle-length]:=help^[stelle];
  256.             END;
  257.             INC (stelle);
  258.           END;
  259.           help^[stelle-length]:=0C;
  260.         END;  (* IF found *)
  261.       END;  (* FOR nr *)
  262.     ELSIF len#-1 THEN
  263.       IF buf#NIL THEN e.FreeMem (buf,len); END;
  264.       Request ('Unable to load "Modula:s/ShowError.config"',NIL);
  265.     END;  (* IF LoadDat *)
  266.   END;  (* WITH config *)
  267. END LoadConfig;
  268.  
  269. PROCEDURE FreeErrors;
  270. VAR help:ListPtr;
  271. BEGIN
  272.   WHILE rootL#NIL DO
  273.     help:=rootL^.next; e.FreeMem (rootL,SIZE(List)+rootL^.size); rootL:=help;
  274.   END;
  275. END FreeErrors;
  276.  
  277. PROCEDURE GetError (buf:Pchars;len:LONGINT);
  278. VAR nr,nr2,pos:LONGINT;
  279.     spalte,zeile:INTEGER;
  280.     msg:str255;
  281.     akt,help:ListPtr;
  282. BEGIN
  283.   nr:=1;
  284.   WHILE nr<len DO
  285.     IF (buf^[nr]="\n") AND ((buf^[nr+1]="@") OR (buf^[nr+1]="^")) THEN
  286.       INC (nr); nr2:=nr;
  287.       WHILE (nr2<len) AND (buf^[nr2]#"\n") DO INC (nr2); END;
  288.       IF (buf^[nr2]="\n") AND (buf^[nr2+1]="@") THEN
  289.         spalte:=1;
  290.         WHILE (buf^[nr+spalte-1]#"\n") AND (nr<len) DO
  291.           IF buf^[nr+spalte-1]="^" THEN
  292.             pos:=0; zeile:=0;
  293.             WHILE buf^[nr2]#"m" DO INC (nr2); END; INC (nr2);
  294.             WHILE (buf^[nr2]>="0") AND (buf^[nr2]<="9") DO
  295.               zeile:=zeile*10+ORD(buf^[nr2])-ORD("0");
  296.               INC (nr2);
  297.             END;
  298.             WHILE buf^[nr2]#"m" DO INC (nr2); END; INC (nr2);
  299.             WHILE buf^[nr2]#"\n" DO
  300.               IF buf^[nr2]=33C THEN
  301.                 WHILE buf^[nr2]#"m" DO INC (nr2); END;
  302.               ELSE msg[pos]:=buf^[nr2]; INC (pos); END;
  303.               INC (nr2);
  304.             END;
  305.             msg[pos]:=0C;
  306.             akt:=e.AllocMem (SIZE(List)+pos+1,{});
  307.             IF akt=NIL THEN
  308.               Request (errMem,NIL);
  309.               nr:=len;
  310.             ELSE
  311.               akt^.zeile:=zeile;
  312.               akt^.spalte:=spalte;
  313.               akt^.size:=pos+1;
  314.               akt^.next:=NIL;
  315.               e.CopyMem (ADR(msg),ADDRESS(akt)+SIZE(List),pos+1);
  316.               IF rootL=NIL THEN rootL:=akt; help:=rootL;
  317.               ELSE
  318.                 help^.next:=akt; help:=akt;
  319.               END;
  320.             END;
  321.           END;  (* IF buf^[nr+spalte-1]="^" *)
  322.           INC (spalte);
  323.         END;  (* WHILE buf^[nr+spalte-1]#"\n" *)
  324.       END;  (* IF buf^[nr2] *)
  325.     END;  (* IF (buf^[nr]="\n") *)
  326.     INC (nr);
  327.   END;  (* WHILE nr<len *)
  328. END GetError;
  329.  
  330. PROCEDURE ReadErrors():BOOLEAN;
  331. VAR len:LONGINT;
  332.     buf:Pchars;
  333.     ok:BOOLEAN;
  334. BEGIN
  335.   ok:=FALSE; buf:=NIL;
  336.   IF LoadDat (ErrFile,buf,len) THEN
  337.     FreeErrors;
  338.     GetError (buf,len);
  339.     ok:=rootL#NIL;
  340.     IF buf#NIL THEN e.FreeMem (buf,len); END;
  341.   ELSE
  342.     IF buf#NIL THEN e.FreeMem (buf,len); END;
  343.     Fehler ('Unable to load "t:Errors"');
  344.   END;
  345.   RETURN ok;
  346. END ReadErrors;
  347.  
  348. VAR msg:r.RexxMsgPtr;
  349.     args:ARRAY [0..7] OF LONGINT; (* port,quit,read,first,next,prev,line,column *)
  350.     rd:d.RDArgsPtr;
  351.     nrequest:d.NotifyRequest;
  352.     notify:BOOLEAN;
  353.  
  354. PROCEDURE ZeigError (getRes:BOOLEAN);
  355. VAR copyProc:LONGCARD;
  356.     arg:str255;
  357.     dat:ARRAY [0..1] OF LONGINT;
  358.     ok:BOOLEAN;
  359. BEGIN
  360.   IF getRes AND (msg^.rm_Result2=0) THEN
  361.     msg^.rm_Result2:=ADDRESS(
  362.       r.CreateArgstring (ADDRESS(ADDRESS(aktErr)+SIZE(List)),aktErr^.size-1));
  363.   END;
  364.   WITH config DO
  365.     IF config.port#NIL THEN
  366.       copyProc:=16C04E75H; ok:=TRUE;
  367.       IF line#NIL THEN
  368.         dat:=[aktErr^.zeile,aktErr^.spalte];
  369.         e.RawDoFmt (line,ADR(dat),PROC(ADR(copyProc)),ADR(arg));
  370.         ok:=senden (ioPort,PortName,port,arg);
  371.       END;
  372.       IF ok AND (col#NIL) THEN
  373.         dat:=[aktErr^.spalte,aktErr^.zeile];
  374.         e.RawDoFmt (col,ADR(dat),PROC(ADR(copyProc)),ADR(arg));
  375.         ok:=senden (ioPort,PortName,port,arg);
  376.       END;
  377.       IF ok THEN
  378.         ok:=sendText (ADDRESS(ADDRESS(aktErr)+SIZE(List)),arg);
  379.       END;
  380.     END;  (* IF config.port#NIL *)
  381.   END;  (* WITH config *)
  382. END ZeigError;
  383.  
  384. PROCEDURE HandleArgs (getRes:BOOLEAN):INTEGER;
  385. VAR nr,anz,rc:INTEGER;
  386.     help:ListPtr;
  387. BEGIN
  388.   rc:=0;
  389.   IF (args[2]=d.DOSTRUE) THEN  (* read *)
  390.     IF ReadErrors() THEN
  391.       aktErr:=rootL; ZeigError (getRes);
  392.     ELSE rc:=15; END;
  393.   END;
  394.   anz:=0;
  395.   FOR nr:=3 TO 7 DO
  396.     INC (anz,args[nr]);
  397.   END;
  398.   IF (anz#0) AND (rootL=NIL) THEN
  399.     Fehler ("Error: No Errorfile loaded"); rc:=10;
  400.   ELSE
  401.     IF args[3]=d.DOSTRUE THEN  (* first *)
  402.       aktErr:=rootL; ZeigError (getRes);
  403.     END;
  404.     IF args[4]=d.DOSTRUE THEN  (* next *)
  405.       IF aktErr^.next#NIL THEN
  406.         aktErr:=aktErr^.next; ZeigError (getRes);
  407.       ELSE Fehler ("Error: No more errors"); rc:=5; END;
  408.     END;
  409.     IF args[5]=d.DOSTRUE THEN  (* prev *)
  410.       IF aktErr#rootL THEN
  411.         help:=rootL;
  412.         WHILE help^.next#aktErr DO help:=help^.next; END;
  413.         aktErr:=help;
  414.         ZeigError (getRes);
  415.       ELSE Fehler ("Error: No previous error"); rc:=5; END;
  416.     END;
  417.     IF getRes AND (msg^.rm_Result2=0) AND
  418.        ((args[6]=d.DOSTRUE) OR (args[7]=d.DOSTRUE)) THEN
  419.       IF args[6]=d.DOSTRUE THEN nr:=aktErr^.zeile; END;  (* line *)
  420.       IF args[7]=d.DOSTRUE THEN nr:=aktErr^.spalte; END;  (* column *)
  421.       buffer:="       "; anz:=7;
  422.       REPEAT
  423.         DEC (anz);
  424.         buffer[anz]:=CHR(ORD("0")+nr MOD 10);
  425.         nr:=nr DIV 10;
  426.       UNTIL nr=0;
  427.       msg^.rm_Result2:=ADDRESS(r.CreateArgstring (ADR(buffer[anz]),
  428.                                                   s.strlen(buffer)-anz));
  429.     END;
  430.   END;  (* IF Error loaded *)
  431.   FOR nr:=2 TO 7 DO
  432.     args[nr]:=d.DOSFALSE;
  433.   END;
  434.   RETURN rc;
  435. END HandleArgs;
  436.  
  437. PROCEDURE GetNewPort;
  438. BEGIN
  439.   IF args[0]#NIL THEN
  440.     WITH config DO
  441.       IF newport THEN free (port); END;
  442.       port:=malloc (s.strlen (ADDRESS(args[0]))+1);
  443.       s.strcpy (port,ADDRESS(args[0]));
  444.       newport:=TRUE;
  445.     END;
  446.   END;
  447. END GetNewPort;
  448.  
  449. PROCEDURE HandlePort;
  450. VAR arg:str60;
  451.     set,wset:LONGSET;
  452.     nr:INTEGER;
  453. BEGIN
  454.   rd:=d.AllocDosObject (d.DOS_RDARGS,NIL);
  455.   IF rd=NIL THEN _ErrorReq (" ","Not enough memory"); END;
  456.   rd^.RDA_Flags:=d.RDAF_NOPROMPT;
  457.   wset:=LONGSET{ioPort^.mp_SigBit,d.SIGBREAKB_CTRL_C};
  458.   IF notify THEN INCL (wset,nrequest.nr_stuff.nr_Signal.nr_SignalNum); END;
  459.   LOOP
  460.     IF args[1]=d.DOSTRUE THEN EXIT; END;
  461.     set:=e.Wait (wset);
  462.     IF d.SIGBREAKB_CTRL_C IN set THEN
  463.       EXIT;
  464.     ELSIF (nrequest.nr_stuff.nr_Signal.nr_SignalNum IN set) AND notify THEN
  465.       IF senden (ioPort,PortName,config.port,config.notify) THEN
  466.         args[2]:=d.DOSTRUE;
  467.         nr:=HandleArgs (FALSE);
  468.       END;
  469.     ELSIF ioPort^.mp_SigBit IN set THEN
  470.       e.WaitPort (ioPort);
  471.       msg:=e.GetMsg (ioPort);
  472.       WHILE msg#NIL DO
  473.         IF (msg^.rm_Node.mn_Node.ln_Type=e.NT_REPLYMSG) THEN
  474.           IF msg^.rm_Args[0]#NIL THEN r.DeleteArgstring (msg^.rm_Args[0]); END;
  475.           msg^.rm_Node.mn_Node.ln_Name:=NIL;
  476.           r.DeleteRexxMsg (msg);
  477.           DEC (replyCnt);
  478.         ELSE
  479.           IF msg^.rm_Args[0]#NIL THEN
  480.             msg^.rm_Result1:=0; msg^.rm_Result2:=0;
  481.             s.strncpy (arg,msg^.rm_Args[0],48);
  482.             WITH rd^ DO
  483.               RDA_Source.CS_Buffer:=ADR(arg);
  484.               RDA_Source.CS_Length:=s.strlen(arg)+1;
  485.               arg[RDA_Source.CS_Length-1]:=12C;
  486.               arg[RDA_Source.CS_Length]:=0C;
  487.               RDA_Source.CS_CurChr:=0;
  488.               RDA_DAList:=NIL;
  489.               RDA_Buffer:=NIL;
  490.             END;
  491.             args[0]:=0;
  492.             IF d.ReadArgs(tempRexx,ADR(args),rd)#NIL THEN
  493.               GetNewPort;
  494.               d.FreeArgs (rd);
  495.               msg^.rm_Result1:=HandleArgs (r.RXFB_RESULT IN LONGSET(msg^.rm_Action));
  496.             ELSE
  497.               msg^.rm_Result1:=20;
  498.             END;
  499.           END;
  500.           e.ReplyMsg (msg);
  501.         END;
  502.         msg:=e.GetMsg (ioPort);
  503.       END;  (* WHILE msg#NIL *)
  504.     END;  (* ELSIF ioPort^.mp_SigBit IN set *)
  505.   END;  (* LOOP *)
  506. END HandlePort;
  507.  
  508. VAR argstr:ARRAY [1..5] OF STRING;
  509.     nr:INTEGER;
  510.     signal:SHORTINT;
  511. BEGIN
  512.   rootL:=NIL; aktErr:=NIL; ioPort:=NIL; replyCnt:=0;
  513.   signal:=-1; notify:=FALSE; rd:=NIL;
  514.   config:=[NIL,-1,NIL,NIL,NIL,NIL,NIL,FALSE,FALSE,255];
  515.   args[0]:=0;
  516.   rd:=d.ReadArgs (tempDos,ADR(args),NIL);
  517.   IF rd#NIL THEN
  518.     GetNewPort;
  519.     d.FreeArgs (rd); rd:=NIL;
  520.   ELSE
  521.     d.Fault (d.IoErr(),NIL,buffer,SIZE(buffer));
  522.     _ErrorReq (" ",buffer);
  523.   END;
  524.   ioPort:=e.FindPort (PortName);
  525.   IF ioPort=NIL THEN
  526.     ioPort:=a.CreatePort (PortName,0);
  527.     IF ioPort=NIL THEN _ErrorReq (" ","Unable to open MsgPort"); END;
  528.     LoadConfig (config);
  529.     IF (config.port#NIL) AND (config.notify#NIL) THEN
  530.       signal:=e.AllocSignal (-1);
  531.       IF signal=-1 THEN
  532.         Request ("Unable to get signal\nNotify not possible",NIL)
  533.       ELSE
  534.         WITH nrequest DO
  535.           nr_Name:=ErrFile;
  536.           nr_Flags:=d.NRF_SEND_SIGNAL;
  537.           nr_stuff.nr_Signal.nr_Task:=e.FindTask (NIL);
  538.           nr_stuff.nr_Signal.nr_SignalNum:=signal;
  539.         END;
  540.         notify:=d.StartNotify (ADR(nrequest));
  541.         IF NOT notify THEN
  542.           Request ("Notify not possible",NIL);
  543.           e.FreeSignal (signal);
  544.           signal:=-1;
  545.         END;
  546.       END;
  547.     END;
  548.     nr:=HandleArgs (FALSE);
  549.     HandlePort;
  550.   ELSE
  551.     ioPort:=a.CreatePort (ReplyName,0);
  552.     IF ioPort=NIL THEN _ErrorReq (" ","Unable to open MsgPort"); END;
  553.     IF config.port#NIL THEN
  554.       buffer:='PORT "'; s.strcat(buffer,config.port);
  555.       s.strcat(buffer,'" ');
  556.     ELSE
  557.       buffer:="";
  558.     END;
  559.     argstr:=["QUIT ","READ ","FIRST ","NEXT ","PREV "];
  560.     FOR nr:=1 TO 5 DO
  561.       IF args[nr]=d.DOSTRUE THEN s.strcat(buffer,argstr[nr]); END;
  562.     END;
  563.     IF senden (ioPort,ReplyName,PortName,buffer) THEN END;
  564.   END;  (* IF ioPort#NIL *)
  565. CLOSE
  566.   IF config.buf#NIL THEN e.FreeMem (config.buf,config.len); END;
  567.   FreeErrors;
  568.   IF notify THEN d.EndNotify (ADR(nrequest)); notify:=FALSE; END;
  569.   IF signal#-1 THEN
  570.     e.FreeSignal (signal); signal:=-1;
  571.   END;
  572.   IF rd#NIL THEN d.FreeDosObject (d.DOS_RDARGS,rd); rd:=NIL; END;
  573.   IF ioPort#NIL THEN
  574.     e.RemPort (ioPort);
  575.     WHILE replyCnt>0 DO
  576.       e.WaitPort (ioPort);
  577.       msg:=e.GetMsg (ioPort);
  578.       WHILE msg#NIL DO
  579.         IF (msg^.rm_Node.mn_Node.ln_Type=e.NT_REPLYMSG) THEN
  580.           IF msg^.rm_Args[0]#NIL THEN r.DeleteArgstring (msg^.rm_Args[0]); END;
  581.           msg^.rm_Node.mn_Node.ln_Name:=NIL;
  582.           r.DeleteRexxMsg (msg);
  583.           DEC (replyCnt);
  584.         ELSE
  585.           e.ReplyMsg (msg);
  586.         END;
  587.         msg:=e.GetMsg (ioPort);
  588.       END;
  589.     END;  (* WHILE *)
  590.     e.Forbid;
  591.     msg:=e.GetMsg (ioPort);
  592.     WHILE msg#NIL DO
  593.       e.ReplyMsg (msg);
  594.       msg:=e.GetMsg (ioPort);
  595.     END;
  596.     a.DeletePort (ioPort);
  597.     e.Permit;
  598.     ioPort:=NIL;
  599.   END;
  600. END ShowError.
  601.